home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / scroll_s / scroll.frm < prev    next >
Text File  |  1997-07-26  |  4KB  |  131 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "By Kevin Smith EMAIL: kjsmith@ozemail.com.au"
  5.    ClientHeight    =   4170
  6.    ClientLeft      =   2340
  7.    ClientTop       =   2805
  8.    ClientWidth     =   6690
  9.    Height          =   4575
  10.    Icon            =   "scroll.frx":0000
  11.    Left            =   2280
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   4170
  16.    ScaleWidth      =   6690
  17.    Top             =   2460
  18.    Width           =   6810
  19.    Begin VB.Timer Timer1 
  20.       Left            =   180
  21.       Top             =   3180
  22.    End
  23.    Begin VB.HScrollBar HScroll1 
  24.       Height          =   195
  25.       Left            =   180
  26.       TabIndex        =   2
  27.       Top             =   3960
  28.       Width           =   6375
  29.    End
  30.    Begin VB.PictureBox Picture2 
  31.       Appearance      =   0  'Flat
  32.       AutoRedraw      =   -1  'True
  33.       AutoSize        =   -1  'True
  34.       BackColor       =   &H80000005&
  35.       ForeColor       =   &H80000008&
  36.       Height          =   3285
  37.       Left            =   -120
  38.       Picture         =   "scroll.frx":0442
  39.       ScaleHeight     =   3255
  40.       ScaleWidth      =   19200
  41.       TabIndex        =   1
  42.       Top             =   4560
  43.       Width           =   19230
  44.    End
  45.    Begin VB.PictureBox Picture1 
  46.       Height          =   1935
  47.       Left            =   240
  48.       ScaleHeight     =   217
  49.       ScaleMode       =   0  'User
  50.       ScaleWidth      =   409
  51.       TabIndex        =   0
  52.       Top             =   240
  53.       Width           =   6195
  54.    End
  55.    Begin VB.Label Label3 
  56.       Alignment       =   2  'Center
  57.       BackStyle       =   0  'Transparent
  58.       Height          =   195
  59.       Left            =   600
  60.       TabIndex        =   3
  61.       Top             =   3660
  62.       Width           =   5835
  63.    End
  64. End
  65. Attribute VB_Name = "Form1"
  66. Attribute VB_Creatable = False
  67. Attribute VB_Exposed = False
  68. Const SRCCOPY = &HCC0020
  69. Const PIXELS = 3
  70.  
  71.  
  72. Private Sub Form_Load()
  73.  
  74. ' Center the Form
  75. Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
  76.  
  77. ' Set the Scale Mode to PIXELS (3) the modes are:
  78. '0   Indicates that one or more of the ScaleHeight, ScaleWidth, ScaleLeft, and ScaleTop properties are set to custom values.
  79. '1   (Default) Twip (1440 twips per logical inch; 567 twips per logical centimeter).
  80. '2   Point (72 points per logical inch).
  81. '3   Pixel (smallest unit of monitor or printer resolution).
  82. '4   Character (horizontal = 120 twips per unit; vertical = 240 twips per unit).
  83. '5   Inch.
  84. '6   Millimeter.
  85. '7   Centimeter.
  86. ' BitBlt uses the PIXEL Mode.....
  87.  
  88. Picture1.ScaleMode = PIXELS
  89. Picture2.ScaleMode = PIXELS
  90.  
  91. ' Make Picture1 the same height as Picture2 (217 pixels in this demo)
  92. Picture1.Height = Picture2.Height
  93.  
  94. ' Make The Maxium Scrolling rate 40 pixels at a time
  95. HScroll1.Max = 40
  96. HScroll1.LargeChange = 2
  97.  
  98. ' Kick start the Timer
  99. Timer1.Interval = 10
  100.  
  101.  
  102. End Sub
  103.  
  104. Private Sub Label2_Click()
  105.  
  106. End Sub
  107.  
  108. Private Sub Timer1_Timer()
  109. Label3.Caption = "Scroll Speed = " & HScroll1
  110.  
  111. Static x As Integer
  112. Dim AWidth As Integer
  113. Dim rc As Integer ' used for return code for BltBit
  114.  
  115. ' Calaculate the next x position for picture 2
  116. x = x + HScroll1
  117. If x > Picture2.ScaleWidth Then x = 0
  118.  
  119. If x > (Picture2.ScaleWidth - Picture1.ScaleWidth) Then
  120.     AWidth = Picture2.ScaleWidth - x
  121.     rc = BitBlt(Picture1.hDC, 0, 0, AWidth, Picture2.ScaleHeight, Picture2.hDC, x, 0, SRCCOPY)
  122.     rc = BitBlt(Picture1.hDC, AWidth, 0, Picture1.ScaleWidth - AWidth, Picture2.ScaleHeight, Picture2.hDC, 0, 0, SRCCOPY)
  123. Else
  124.     rc = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture2.ScaleHeight, Picture2.hDC, x, 0, SRCCOPY)
  125. End If
  126.  
  127.  
  128. End Sub
  129.  
  130.  
  131.